perm filename WINSUB.FAI[VIS,HPM]1 blob sn#109103 filedate 1974-07-03 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE	WINSUB
C00005 00003	***** SAIL INTERFACE ********
C00006 ENDMK
C⊗;
	TITLE	WINSUB
	INTERN	WIND,HORWIN,VERWIN
	ENTRY	INIWIN,DOWIN
	EXTERN	PICWID,PICLIN,PICHIG,PICBIT
WIND:	0
HORWIN:	0
VERWIN:	0

STRIP:	BLOCK	50000
PICWIZ:	0
	ARRYO←0 ↔ ARRY←CNT2←1 ↔ VW←2 ↔ T←3 ↔ STRP←4 ↔ PNT←5 ↔ CNT←6
	HC←7 ↔ VC←10 ↔ D1C←11 ↔ D2C←12 ↔ CNT1←13 ↔ TOP←14 ↔ POS←15 ↔ SUM←16
	FOR I←-100,-1,1 { I*I
				}
SQRS:	FOR I←0,100,1   {I*I
				}

PERUSE:	0
	MOVEI	STRP,44
	IDIV	STRP,PICBIT
	IMUL	STRP,PICLIN
	MOVEM	STRP,PICWIZ
	MOVN	STRP,STRP
	IMUL	STRP,WIND
	SUB	STRP,PICWIZ
	HRLZ	STRP,STRP
	HRLZ	PNT,PICBIT
	LSH	PNT,6
	ADDI	PNT,-1(ARRY)
	MOVE	CNT,[SUB T,STRIP(POS)]
	ADD	CNT,PICWIZ
	MOVEM	CNT,PP
	MOVEM	CNT,PP0
	ADDI	CNT,1
	MOVEM	CNT,PP1
	SUBI	ARRYO,1
	MOVE	VW,VERWIN
	SETZ	SUM,
VERLP:	MOVE	CNT,STRP
UNPAK:	ILDB	T,PNT
	MOVEM	T,STRIP(CNT)
	AOBJN	CNT,UNPAK
	MOVE	CNT,HORWIN
	SETZB	POS,TOP
KLP:	SETZB	HC,VC
	SETZB	D1C,D2C
	MOVE	CNT2,WIND
JLP:	MOVE	CNT1,WIND
ILP:	MOVE	T,STRIP(POS)
	SUB	T,STRIP+1(POS)
	ADD	HC,SQRS(T)
	MOVE	T,STRIP(POS)
PP:	SUB	T,STRIP+1(POS)			;REPLACED BY STRIP+<PICWID>(POS)
	ADD	VC,SQRS(T)
	MOVE	T,STRIP(POS)
PP1:	SUB	T,STRIP+1(POS)			;REPLACED BY STRIP +<PICWID>+1
	ADD	D1C,SQRS(T)
	MOVE	T,STRIP+1(POS)
PP0:	SUB	T,STRIP+1(POS)			;REPLACED BY STRIP+<PICWID>
	ADD	D2C,SQRS(T)
	ADD	POS,PICWIZ
	SOJG	CNT1,ILP
	AOS	POS,TOP
	SOJG	CNT2,JLP
	CAMLE	HC,VC
	MOVE	HC,VC
	CAMLE	HC,D1C
	MOVE	HC,D1C
	CAMLE	HC,D2C
	MOVE	HC,D2C
	ADD	SUM,HC
	PUSH	ARRYO,HC
	SOJG	CNT,KLP
	SUB	PNT,PICLIN
	SOJG	VW,VERLP
	JRST	@PERUSE

;***** SAIL INTERFACE ********

	P←17

ACS12:	0
ACS16:	0
ACS17:	0
RETAD:	0


INIWIN:	POP	P,RETAD
	POP	P,WIND
	MOVE	1,PICWID
	SUBI	1,1
	IDIV	1,WIND
	MOVEM	1,HORWIN
	MOVE	1,PICHIG
	SUBI	1,1
	IDIV	1,WIND
	MOVEM	1,VERWIN
	JRST	@RETAD

DOWIN:	MOVEM	12,ACS12
	MOVEM	16,ACS16
	POP	P,RETAD
	POP	P,ARRYO
	POP	P,ARRY
	MOVEM	17,ACS17
	JSR	PERUSE
	MOVE	12,ACS12
	MOVE	16,ACS16
	MOVE	17,ACS17
	JRST	@RETAD


	END